perm filename SOLNS1.F74[206,LSP] blob sn#135143 filedate 1974-12-05 generic text, type T, neo UTF8

(DEFPROP HS
 (NIL ALT
      ODDS
      ODDS1
      ENTER
      COMMONTAIL
      COMMONR
      RCYCLE
      LCYCLE
      PERMUT
      PERMUT1
      PERMUT2
      REV1
      CONN
      COMP
      MERGCOMPS
      MERGCOMP
      UNION)
VALUE)

(DEFPROP ALT
 (LAMBDA (U M N) (COND ((NULL U) NIL) ((EQ M 1) (CONS (CAR U) (ALT (CDR U) N N))) (T (ALT (CDR U) (SUB1 M) N))))
EXPR)

(DEFPROP ODDS
 (LAMBDA (U) (ODDS1 U NIL))
EXPR)

(DEFPROP ODDS1
 (LAMBDA (U V) (COND ((NULL U) V) (T (ODDS1 (CDR U) (ENTER (CAR U) V)))))
EXPR)

(DEFPROP ENTER
 (LAMBDA (X V) (COND ((NULL V) (LIST X)) ((EQUAL (CAR V) X) (CDR V)) (T (CONS (CAR V) (ENTER X (CDR V))))))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (COMMONR (REVERSE U) (REVERSE V) NIL))
EXPR)

(DEFPROP COMMONR
 (LAMBDA(U V W)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) W)
	(T (COMMONR (CDR U) (CDR V) (CONS (CAR U) W)))))
EXPR)

(DEFPROP RCYCLE
 (LAMBDA (U) ((LAMBDA (V) (CONS (CAR V) (REVERSE (CDR V)))) (REVERSE U)))
EXPR)

(DEFPROP LCYCLE
 (LAMBDA (U) (APPEND (CDR U) (LIST (CAR U))))
EXPR)

(DEFPROP PERMUT
 (LAMBDA (U) (COND ((NULL U) (QUOTE (NIL))) (T (PERMUT1 (CAR U) (PERMUT (CDR U))))))
EXPR)

(DEFPROP PERMUT1
 (LAMBDA (X W) (COND ((NULL W) NIL) (T (APPEND (PERMUT2 NIL X (CAR W)) (PERMUT1 X (CDR W))))))
EXPR)

(DEFPROP PERMUT2
 (LAMBDA(U X V)
  (COND	((NULL V) (LIST (REVERSE (CONS X U))))
	(T (CONS (REV1 (CONS X U) V) (PERMUT2 (CONS (CAR V) U) X (CDR V))))))
EXPR)

(DEFPROP REV1
 (LAMBDA (U V) (COND ((NULL U) V) (T (REV1 (CDR U) (CONS (CAR U) V)))))
EXPR)

(DEFPROP CONN
 (LAMBDA (U) (LESSP (COMP U) 2))
EXPR)

(DEFPROP COMP
 (LAMBDA (U) (LENGTH (MERGCOMPS U)))
EXPR)

(DEFPROP MERGCOMPS
 (LAMBDA (U) (COND ((NULL U) NIL) (T (MERGCOMP (CAAR U) (CAR U) (MERGCOMPS (CDR U))))))
EXPR)

(DEFPROP MERGCOMP
 (LAMBDA(X C L)
  (COND	((NULL L) (LIST C))
	((MEMBER X (CAR L)) (MERGCOMP X (UNION C (CAR L)) (CDR L)))
	(T (CONS (CAR L) (MERGCOMP X C (CDR L))))))
EXPR)

(DEFPROP UNION
 (LAMBDA (U V) (COND ((NULL U) V) ((MEMBER (CAR U) V) (UNION (CDR U) V)) (T (CONS (CAR U) (UNION (CDR U) V)))))
EXPR)